***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
*REST from n:report ADDI                                                                                                                                                                                                                                  
*TGL=PRITGL+1                                                                                                                                                                                                                                             
*if tgl=date()                                                                                                                                                                                                                                            
*   save all like pri* to n:report                                                                                                                                                                                                                        
*   return                                                                                                                                                                                                                                                
*endif                                                                                                                                                                                                                                                    
*REPRI=0                                                                                                                                                                                                                                                  
*IF PRIACT                                                                                                                                                                                                                                                
*   REPRI=1                                                                                                                                                                                                                                               
*ENDIF                                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
tgl=date()-1                                                                                                                                                                                                                                              
do while .t.                                                                                                                                                                                                                                              
   @ 10, 48 SAY 'Transaction Date : ' get tgl pict '99/99/9999'                                                                                                                                                                                           
   read                                                                                                                                                                                                                                                   
   if tgl>=date()                                                                                                                                                                                                                                         
      loop                                                                                                                                                                                                                                                
   endif                                                                                                                                                                                                                                                  
   exit                                                                                                                                                                                                                                                   
enddo                                                                                                                                                                                                                                                     
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
IF MONTH(DATE())<>MONTH(TGL)                                                                                                                                                                                                                              
   DR='Q:'                                                                                                                                                                                                                                                
   F1='ACTIVIT2'                                                                                                                                                                                                                                          
   F2='ACT_PRO2'                                                                                                                                                                                                                                          
   F21='ACT_PRO2'                                                                                                                                                                                                                                         
   F3='ACT_PHA2'                                                                                                                                                                                                                                          
   F31='ACT_PHA2'                                                                                                                                                                                                                                         
ELSE                                                                                                                                                                                                                                                      
   DR='N:'                                                                                                                                                                                                                                                
   F1='ACTIVIT1'                                                                                                                                                                                                                                          
   F2='ACT_PRO1'                                                                                                                                                                                                                                          
   F3='ACT_PHA1'                                                                                                                                                                                                                                          
   F21='ACT_PRX1'                                                                                                                                                                                                                                         
   F31='ACT_PHX1'                                                                                                                                                                                                                                         
ENDIF                                                                                                                                                                                                                                                     
DR1='N:'                                                                                                                                                                                                                                                  
F4='MEDIC_PR'                                                                                                                                                                                                                                             
F5='MAIN_ARE'                                                                                                                                                                                                                                             
F6='DRUGS'                                                                                                                                                                                                                                                
F7='DISPOS'                                                                                                                                                                                                                                               
F8='DOCTORS'                                                                                                                                                                                                                                              
store 0 to pl1,pl2,pl3,CTR,fl,Fl,ttl,TTL1,med,den,xry,lab,tot,pres,ctrr,cnterm,cnterp,cnter,hl                                                                                                                                                            
do while pl1=0                                                                                                                                                                                                                                            
   @ 12,60 say '/'                                                                                                                                                                                                                                        
   @ 12,54 prompt 'Print'                                                                                                                                                                                                                                 
   @ 12,62 prompt 'Quit'                                                                                                                                                                                                                                  
   menu to pl1                                                                                                                                                                                                                                            
   if pl1=2                                                                                                                                                                                                                                               
      RETN=.T.                                                                                                                                                                                                                                            
      return                                                                                                                                                                                                                                              
   else                                                                                                                                                                                                                                                   
      @ 14,60 say '/'                                                                                                                                                                                                                                     
      @ 14,46 prompt 'Printer Ready'                                                                                                                                                                                                                      
      @ 14,62 prompt 'Not Yet Ready'                                                                                                                                                                                                                      
      menu to pl2                                                                                                                                                                                                                                         
      if pl2=2                                                                                                                                                                                                                                            
         @ 14,46 clea to 14,78                                                                                                                                                                                                                            
         pl1=0                                                                                                                                                                                                                                            
      else                                                                                                                                                                                                                                                
         @ 16,46 say '        Printing...    '                                                                                                                                                                                                            
         set console off                                                                                                                                                                                                                                  
         set devi to prin                                                                                                                                                                                                                                 
      endif                                                                                                                                                                                                                                               
   endif                                                                                                                                                                                                                                                  
enddo                                                                                                                                                                                                                                                     
br=100                                                                                                                                                                                                                                                    
set devi to print                                                                                                                                                                                                                                         
@ 0,0 say chr(15) pict 'x'                                                                                                                                                                                                                                
SELE 1                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F1                                                                                                                                                                                                                                                
locate for date_visit=tgl                                                                                                                                                                                                                                 
do case                                                                                                                                                                                                                                                   
   case .NOT. FOUND()                                                                                                                                                                                                                                     
      return                                                                                                                                                                                                                                              
   CASE DATE_VISIT=DATE()                                                                                                                                                                                                                                 
      return                                                                                                                                                                                                                                              
   OTHER                                                                                                                                                                                                                                                  
      do while date_visit=tgl                                                                                                                                                                                                                             
         CTRR=CTRR+1                                                                                                                                                                                                                                      
         if br>60                                                                                                                                                                                                                                         
            if fl>0                                                                                                                                                                                                                                       
               eject                                                                                                                                                                                                                                      
            else                                                                                                                                                                                                                                          
               fl=1                                                                                                                                                                                                                                       
            endif                                                                                                                                                                                                                                         
            cl=50                                                                                                                                                                                                                                         
            hl=hl+1                                                                                                                                                                                                                                       
            @  1, 90 say "page :"                                                                                                                                                                                                                         
            @  1, 97 say hl pict "99"                                                                                                                                                                                                                     
            @  2, 44 SAY CHR(27)+'G'                                                                                                                                                                                                                      
            @  2, 44 say 'CLINIC ACTIVITY REPORT for '+dtoc(TGL)                                                                                                                                                                                          
            @  2,44 SAY CHR(27)+'H'                                                                                                                                                                                                                       
            br=4                                                                                                                                                                                                                                          
         endif                                                                                                                                                                                                                                            
         br=br+1                                                                                                                                                                                                                                          
         INVI=INV_NBER                                                                                                                                                                                                                                    
         do while .t.                                                                                                                                                                                                                                     
            SELE 2                                                                                                                                                                                                                                        
            SET EXCLU OFF                                                                                                                                                                                                                                 
            USE &DR&F2 index &dr&f21                                                                                                                                                                                                                      
            brpro=0                                                                                                                                                                                                                                       
            seek DTOS(TGL)+INVI                                                                                                                                                                                                                           
            if eof()                                                                                                                                                                                                                                      
               exit                                                                                                                                                                                                                                       
            else                                                                                                                                                                                                                                          
               do while DATE_VISIT=TGL .AND. inv_nber=invi                                                                                                                                                                                                
                  brpro=brpro+1                                                                                                                                                                                                                           
                  skip                                                                                                                                                                                                                                    
               enddo                                                                                                                                                                                                                                      
               exit                                                                                                                                                                                                                                       
            endif                                                                                                                                                                                                                                         
         enddo                                                                                                                                                                                                                                            
         do while .t.                                                                                                                                                                                                                                     
            SELE 3                                                                                                                                                                                                                                        
            SET EXCLU OFF                                                                                                                                                                                                                                 
            USE &DR&F3 index &dr&f31                                                                                                                                                                                                                      
            brpha=0                                                                                                                                                                                                                                       
            seek DTOS(TGL)+INVI                                                                                                                                                                                                                           
            if eof()                                                                                                                                                                                                                                      
               exit                                                                                                                                                                                                                                       
            else                                                                                                                                                                                                                                          
               do while DATE_VISIT=TGL .AND. inv_nber=invi                                                                                                                                                                                                
                  brpha=brpha+1                                                                                                                                                                                                                           
                  skip                                                                                                                                                                                                                                    
               enddo                                                                                                                                                                                                                                      
               exit                                                                                                                                                                                                                                       
            endif                                                                                                                                                                                                                                         
         enddo                                                                                                                                                                                                                                            
         sele 1                                                                                                                                                                                                                                           
         if br+brpro+brpha+8>66                                                                                                                                                                                                                           
            eject                                                                                                                                                                                                                                         
            hl=hl+1                                                                                                                                                                                                                                       
            @  1, 90 say "page :"                                                                                                                                                                                                                         
            @  1, 97 say hl pict "99"                                                                                                                                                                                                                     
            @  2, 44 SAY CHR(27)+'G'                                                                                                                                                                                                                      
            @  2, 44 say 'CLINIC ACTIVITY REPORT for '+dtoc(TGL)                                                                                                                                                                                          
            @  2,44 SAY CHR(27)+'H'                                                                                                                                                                                                                       
            br=4                                                                                                                                                                                                                                          
         endif                                                                                                                                                                                                                                            
         ctr=ctr+1                                                                                                                                                                                                                                        
         @ BR,  2 SAY "PATIENT #"                                                                                                                                                                                                                         
         @ br, 12 say ctr pict "999"                                                                                                                                                                                                                      
         @ br, 18 say "Invoice #"                                                                                                                                                                                                                         
         @ BR, 28 SAY INVI PICT "99999"                                                                                                                                                                                                                   
         @ BR, 35 SAY "Code : "+PAT_FILCOD+" "+PAT_CODTYP                                                                                                                                                                                                 
         KODE=PAT_FILCOD                                                                                                                                                                                                                                  
         @ BR, 52 SAY "Name : "+trim(pat_f_name)+" "+PAT_NAME                                                                                                                                                                                             
         @ BR, 86 SAY PAT_SEX                                                                                                                                                                                                                             
         TIPE= PAT_CODTYP                                                                                                                                                                                                                                 
         KODE=PAT_FILCOD                                                                                                                                                                                                                                  
         name=PAT_NAME                                                                                                                                                                                                                                    
         fname=PAT_F_NAME                                                                                                                                                                                                                                 
         minit=PAT_M_INIT                                                                                                                                                                                                                                 
         sex=PAT_SEX                                                                                                                                                                                                                                      
         dob=pat_dob                                                                                                                                                                                                                                      
         do case                                                                                                                                                                                                                                          
            case healthline .and. hl_dent                                                                                                                                                                                                                 
               @ BR, 88 SAY "HEALTHLINE/DENTAL"                                                                                                                                                                                                           
            case healthline .and. .NOT. hl_dent                                                                                                                                                                                                           
               @ BR, 88 SAY "HEALTHLINE"                                                                                                                                                                                                                  
            case med_sCHM                                                                                                                                                                                                                                 
               @ br,88 say 'MEDICAL SCHEME MEMBER'                                                                                                                                                                                                        
            CASE HEALTHLINE=.F.                                                                                                                                                                                                                           
               @ BR, 88 SAY  "         "                                                                                                                                                                                                                  
         ENDCASE                                                                                                                                                                                                                                          
         BR=BR+1                                                                                                                                                                                                                                          
         @ BR,12 SAY "Company :"                                                                                                                                                                                                                          
         @ BR,22 SAY PAT_CORP                                                                                                                                                                                                                             
         @ BR,66 SAY "Date of Birth :"                                                                                                                                                                                                                    
         @ br,82 say dob                                                                                                                                                                                                                                  
         SW1=0                                                                                                                                                                                                                                            
         set conso on                                                                                                                                                                                                                                     
         SELE 2                                                                                                                                                                                                                                           
         SET EXCLU OFF                                                                                                                                                                                                                                    
         USE &DR&F2 index &dr&f21                                                                                                                                                                                                                         
         seek DTOS(TGL)+INVI                                                                                                                                                                                                                              
         DO WHILE .T.                                                                                                                                                                                                                                     
            if eof()                                                                                                                                                                                                                                      
               EXIT                                                                                                                                                                                                                                       
            ELSE                                                                                                                                                                                                                                          
               IF SW1=0                                                                                                                                                                                                                                   
                  SW1=1                                                                                                                                                                                                                                   
                  @  BR+2,0 SAY CHR(27)+'G'                                                                                                                                                                                                               
                  @  BR+2,0 say 'TREATMENT'                                                                                                                                                                                                               
                  @  BR+2,0 SAY CHR(27)+'H'                                                                                                                                                                                                               
                  br=BR+2                                                                                                                                                                                                                                 
               endif                                                                                                                                                                                                                                      
               DO WHILE DATE_VISIT=TGL .AND. inv_nber=invi .AND. PAT_FILCOD=KODE .AND. .NOT. EOF()                                                                                                                                                        
                  br=br+1                                                                                                                                                                                                                                 
                  ACOD=AREA_CODE                                                                                                                                                                                                                          
                  SELE 5                                                                                                                                                                                                                                  
                  SET EXCLU OFF                                                                                                                                                                                                                           
                  USE &DR1&F5                                                                                                                                                                                                                             
                  LOCA FOR AREA_CODE=ACOD                                                                                                                                                                                                                 
                  IF FOUND()                                                                                                                                                                                                                              
                     MAREA=MAIN_AREA                                                                                                                                                                                                                      
                  ENDIF                                                                                                                                                                                                                                   
                  sele 2                                                                                                                                                                                                                                  
                  IF DOC_CODE<>SPACE(3)                                                                                                                                                                                                                   
                     DCOD=DOC_CODE                                                                                                                                                                                                                        
                     SELE 8                                                                                                                                                                                                                               
                     SET EXCLU OFF                                                                                                                                                                                                                        
                     USE &DR1&F8                                                                                                                                                                                                                          
                     LOCA FOR DOC_CODE=DCOD                                                                                                                                                                                                               
                     IF FOUND()                                                                                                                                                                                                                           
                        DALIAS=DOC_ALIAS                                                                                                                                                                                                                  
                     ENDIF                                                                                                                                                                                                                                
                  ENDIF                                                                                                                                                                                                                                   
                  SELE 2                                                                                                                                                                                                                                  
                  @ BR, 6 SAY AREA_CODE+SUB_AREACO+PRO_CODE                                                                                                                                                                                               
                  @ br,14 say proc_x                                                                                                                                                                                                                      
                  @ BR, 20 SAY MAREA                                                                                                                                                                                                                      
                  @ BR, 45 SAY SHRT_DESCR                                                                                                                                                                                                                 
                  IF DOC_CODE<>SPACE(3)                                                                                                                                                                                                                   
                     @ BR, 72 SAY "by Dr. "+DALIAS                                                                                                                                                                                                        
                  ENDIF                                                                                                                                                                                                                                   
                  do case                                                                                                                                                                                                                                 
                     case area_code='G' .or. area_code='S' .or. area_code='Y' .or. area_code='O'                                                                                                                                                          
                        med=med+1                                                                                                                                                                                                                         
                     case area_code='D'                                                                                                                                                                                                                   
                        den=den+1                                                                                                                                                                                                                         
                     case area_code='X'                                                                                                                                                                                                                   
                        xry=xry+1                                                                                                                                                                                                                         
                     case area_code='L'                                                                                                                                                                                                                   
                        lab=lab+1                                                                                                                                                                                                                         
                  endcase                                                                                                                                                                                                                                 
                  SKIP                                                                                                                                                                                                                                    
               ENDDO                                                                                                                                                                                                                                      
               EXIT                                                                                                                                                                                                                                       
            ENDIF                                                                                                                                                                                                                                         
         ENDDO                                                                                                                                                                                                                                            
         sw2=0                                                                                                                                                                                                                                            
         SELE 3                                                                                                                                                                                                                                           
         SET EXCLU OFF                                                                                                                                                                                                                                    
         USE &DR&F3 index &dr&f31                                                                                                                                                                                                                         
         seek DTOS(TGL)+INVI                                                                                                                                                                                                                              
         DO WHILE .T.                                                                                                                                                                                                                                     
            if eof()                                                                                                                                                                                                                                      
               EXIT                                                                                                                                                                                                                                       
            ELSE                                                                                                                                                                                                                                          
               PRES=PRES+1                                                                                                                                                                                                                                
               IF SW2=0                                                                                                                                                                                                                                   
                  SW2=1                                                                                                                                                                                                                                   
                  @ BR+1,0 SAY CHR(27)+'G'                                                                                                                                                                                                                
                  @ BR+1,0 say 'PHARMACY'                                                                                                                                                                                                                 
                  @ BR+1,0 SAY CHR(27)+'H'                                                                                                                                                                                                                
                  br=BR+1                                                                                                                                                                                                                                 
               endif                                                                                                                                                                                                                                      
               DO WHILE DATE_VISIT=TGL .AND. inv_nber=invi .AND. PAT_FILCOD=KODE .AND. .NOT. EOF()                                                                                                                                                        
                  br=br+1                                                                                                                                                                                                                                 
                  tot=tot+1                                                                                                                                                                                                                               
                  PCOD=PHAR_CODE                                                                                                                                                                                                                          
                  SELE 6                                                                                                                                                                                                                                  
                  SET EXCLU OFF                                                                                                                                                                                                                           
                  USE &DR1&F6 index &dr1&f6                                                                                                                                                                                                               
                  SEEK PCOD                                                                                                                                                                                                                               
                  IF EOF()                                                                                                                                                                                                                                
                     SELE 7                                                                                                                                                                                                                               
                     SET EXCLU OFF                                                                                                                                                                                                                        
                     USE &DR1&F7 index &dr1&f7                                                                                                                                                                                                            
                     SEEK PCOD                                                                                                                                                                                                                            
                     IF .NOT. EOF()                                                                                                                                                                                                                       
                        PNAME=DISP_NAME                                                                                                                                                                                                                   
                        PTYPE=DISP_TYPE                                                                                                                                                                                                                   
                        PQANT=DISP_QANT                                                                                                                                                                                                                   
                        PUNIT=DISP_UNIT                                                                                                                                                                                                                   
                        SUNIT=SELL_UNIT                                                                                                                                                                                                                   
                     ENDIF                                                                                                                                                                                                                                
                  ELSE                                                                                                                                                                                                                                    
                     PNAME=DRUG_NAME                                                                                                                                                                                                                      
                     PTYPE=DRUG_TYPE                                                                                                                                                                                                                      
                     PQANT=DRUG_QANT                                                                                                                                                                                                                      
                     PUNIT=DRUG_UNIT                                                                                                                                                                                                                      
                     SUNIT=SELL_UNIT                                                                                                                                                                                                                      
                  ENDIF                                                                                                                                                                                                                                   
                  SELE 3                                                                                                                                                                                                                                  
                  @ BR, 10 SAY PCOD                                                                                                                                                                                                                       
                  @ BR, 16 SAY PNAME                                                                                                                                                                                                                      
                  @ BR, 38 SAY PTYPE                                                                                                                                                                                                                      
                  @ BR, 52 SAY PQANT                                                                                                                                                                                                                      
                  @ BR, 58 SAY PUNIT                                                                                                                                                                                                                      
                  @ BR, 62 SAY PHAR_X                                                                                                                                                                                                                     
                  @ BR, 68 SAY SUNIT                                                                                                                                                                                                                      
                  SKIP                                                                                                                                                                                                                                    
               ENDDO                                                                                                                                                                                                                                      
               EXIT                                                                                                                                                                                                                                       
            ENDIF                                                                                                                                                                                                                                         
         ENDDO                                                                                                                                                                                                                                            
         SELE 1                                                                                                                                                                                                                                           
         BR=BR+3                                                                                                                                                                                                                                          
         continue                                                                                                                                                                                                                                         
      enddo                                                                                                                                                                                                                                               
endcase                                                                                                                                                                                                                                                   
if br>45                                                                                                                                                                                                                                                  
   eject                                                                                                                                                                                                                                                  
   hl=hl+1                                                                                                                                                                                                                                                
   @ 1, 90 say "page :"                                                                                                                                                                                                                                   
   @ 1, 97 say hl pict "99"                                                                                                                                                                                                                               
   br=2                                                                                                                                                                                                                                                   
   @  2, 44 SAY CHR(27)+'G'                                                                                                                                                                                                                               
   @  2, 44 say 'CLINIC ACTIVITY REPORT for '+dtoc(TGL)                                                                                                                                                                                                   
   @  2,44 SAY CHR(27)+'H'                                                                                                                                                                                                                                
endif                                                                                                                                                                                                                                                     
@ BR+2,  4 SAY "LAST VISIT RECORDED for "+DTOC(TGL)                                                                                                                                                                                                       
@ BR+3,  22 SAY 'TOTAL NUMBER OF VISITS : '+STR(CTRR,4)                                                                                                                                                                                                   
@ br+4,22 say 'TOTAL NUMBER OF MEDICAL TREATMENTS : '+str(med,4)                                                                                                                                                                                          
@ br+5,22 say 'TOTAL NUMBER OF DENTAL TREATMENTS  : '+str(den,4)                                                                                                                                                                                          
@ br+6,22 say 'TOTAL NUMBER OF X-RAY / U.S.G.     : '+str(xry,4)                                                                                                                                                                                          
@ br+7,22 say 'TOTAL NUMBER OF LABORATORY TESTS   : '+str(lab,4)                                                                                                                                                                                          
@ br+8,22 say 'TOTAL NUMBER OF PRESCRIPTIONS      : '+str(pres,4)                                                                                                                                                                                         
@ br+9,22 say 'TOTAL NUMBER OF DISPENSING         : '+str(tot,4)                                                                                                                                                                                          
@ br+11,10 say "Copy # 1 : Dr. Inge,         "                                                                                                                                                                                                            
@ br+12,10 say "Copy # 2 : C.D. -->> C. Bond, "                                                                                                                                                                                                           
@ br+13,10 say "Copy # 3 : Billing "                                                                                                                                                                                                                      
@ BR+15,0 SAY CHR(27)+'G'                                                                                                                                                                                                                                 
@ BR+15,0 say repl('-',114)                                                                                                                                                                                                                               
@ BR+15,0 SAY CHR(27)+'H'                                                                                                                                                                                                                                 
BR=100                                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
*stor .t. to priact                                                                                                                                                                                                                                       
*if priact .and. prirev .AND. PRIABN                                                                                                                                                                                                                      
*   PRIBEG=VAL(INVI)                                                                                                                                                                                                                                      
*   PRITGL=TGL                                                                                                                                                                                                                                            
*   priact=.f.                                                                                                                                                                                                                                            
*   prirev=.f.                                                                                                                                                                                                                                            
*   PRIABN=.F.                                                                                                                                                                                                                                            
*endif                                                                                                                                                                                                                                                    
*save all like pri* to n:report                                                                                                                                                                                                                           
                                                                                                                                                                                                                                                          
EJECT                                                                                                                                                                                                                                                     
@ 0,0 SAY CHR(18) PICT 'X'                                                                                                                                                                                                                                
SET DEVI TO SCREEN                                                                                                                                                                                                                                        
@  7, 1 CLEAR to 23,78                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
*IF REPRI=0                                                                                                                                                                                                                                               
*   REST FROM N:MONTHACT addi                                                                                                                                                                                                                             
*   MONVIS=MONVIS+CTRR                                                                                                                                                                                                                                    
*   MONMED=MONMED+MED                                                                                                                                                                                                                                     
*   MONDEN=MONDEN+DEN                                                                                                                                                                                                                                     
*   MONXRY=MONXRY+XRY                                                                                                                                                                                                                                     
*   MONLAB=MONLAB+LAB                                                                                                                                                                                                                                     
*   MONPRS=MONPRS+PRES                                                                                                                                                                                                                                    
*   MONDIS=MONDIS+TOT                                                                                                                                                                                                                                     
*   SAVE ALL LIKE MON* TO N:MONTHACT                                                                                                                                                                                                                      
*ENDIF                                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
CLOSE DATA                                                                                                                                                                                                                                                
CLOSE INDEX                                                                                                                                                                                                                                               
RETURN                                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
